home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / clrmem.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  3KB  |  97 lines
  1. /* clrmem.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal cpyknt;
  12.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  13.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  14.         nwd16;
  15. } memmgr_;
  16.  
  17. #define memmgr_1 memmgr_
  18.  
  19. /* Table of constant values */
  20.  
  21. static integer c__1 = 1;
  22.  
  23. /*<       subroutine clrmem(ipntr) >*/
  24. /* Subroutine */ int clrmem_(ipntr)
  25. integer *ipntr;
  26. {
  27.     static integer muse, msiz, ltab1;
  28.     extern /* Subroutine */ int copy4_(), memadj_(), errmem_();
  29.     extern logical memptr_();
  30.     static integer nwords;
  31.     extern integer nxtevn_();
  32.  
  33.     /* Parameter adjustments */
  34.     --ipntr;
  35.  
  36.     /* Function Body */
  37. /*<       implicit double precision (a-h,o-z) >*/
  38. /*<       dimension ipntr(1) >*/
  39. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  40. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  41. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  42. /*<      2   nwd8,nwd16 >*/
  43. /*<       logical memptr >*/
  44.  
  45. /* ***  clrmem - release block */
  46.  
  47.  
  48. /* ...  check that pointer is valid */
  49. /*<       if (memptr(ipntr(1))) go to 10 >*/
  50.     if (memptr_(&ipntr[1])) {
  51.     goto L10;
  52.     }
  53. /*<       memerr=5 >*/
  54.     memmgr_1.memerr = 5;
  55. /*<       call errmem(1,memerr,ipntr(1)) >*/
  56.     errmem_(&c__1, &memmgr_1.memerr, &ipntr[1]);
  57. /*<    10 msiz=istack(ltab+2) >*/
  58. L10:
  59.     msiz = memmgr_1.istack[memmgr_1.ltab + 1];
  60. /*<       muse=istack(ltab+3) >*/
  61.     muse = memmgr_1.istack[memmgr_1.ltab + 2];
  62. /*<       memavl=memavl+nxtevn(muse)+istack(ltab+6) >*/
  63.     memmgr_1.memavl = memmgr_1.memavl + nxtevn_(&muse) + memmgr_1.istack[
  64.         memmgr_1.ltab + 5];
  65. /* ...  assumption:  first allocated block is never cleared. */
  66. /*<       ltab1=ltab-ntab >*/
  67.     ltab1 = memmgr_1.ltab - memmgr_1.ntab;
  68. /*<       istack(ltab1+2)=istack(ltab1+2)+msiz >*/
  69.     memmgr_1.istack[ltab1 + 1] += msiz;
  70. /* ...  reposition the block table */
  71. /*<       nwords=ltab-loctab >*/
  72.     nwords = memmgr_1.ltab - memmgr_1.loctab;
  73. /*<       cpyknt=cpyknt+dble(nwords) >*/
  74.     memmgr_1.cpyknt += (doublereal) nwords;
  75. /*<       call copy4(istack(loctab+1),istack(loctab+ntab+1),nwords) >*/
  76.     copy4_(&memmgr_1.istack[memmgr_1.loctab], &memmgr_1.istack[
  77.         memmgr_1.loctab + memmgr_1.ntab], &nwords);
  78. /*<       numblk=numblk-1 >*/
  79.     --memmgr_1.numblk;
  80. /*<       loctab=loctab+ntab >*/
  81.     memmgr_1.loctab += memmgr_1.ntab;
  82. /*<       memavl=memavl+ntab >*/
  83.     memmgr_1.memavl += memmgr_1.ntab;
  84. /*<       ltab1=ldval-ntab >*/
  85.     ltab1 = memmgr_1.ldval - memmgr_1.ntab;
  86. /*<       istack(ltab1+2)=istack(ltab1+2)+ntab >*/
  87.     memmgr_1.istack[ltab1 + 1] += memmgr_1.ntab;
  88. /*<       ipntr(1)=2**30-1 >*/
  89.     ipntr[1] = 1073741823;
  90. /*<       call memadj >*/
  91.     memadj_();
  92. /*<       return >*/
  93.     return 0;
  94. /*<       end >*/
  95. } /* clrmem_ */
  96.  
  97.